home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp2.arc / PIBHOSTB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-30  |  32.6 KB  |  856 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Process_Host_Commands --- Process main menu commands         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE Process_Host_Commands( VAR Done: BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Process_Host_Commands                                *)
  10. (*                                                                      *)
  11. (*     Purpose:    Controls processing of main menu commands.           *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Process_Host_Commands( VAR Done: BOOLEAN );                   *)
  16. (*                                                                      *)
  17. (*           Done --- set TRUE if quit command entered or carrier       *)
  18. (*                    dropped.                                          *)
  19. (*                                                                      *)
  20. (*----------------------------------------------------------------------*)
  21.  
  22. VAR
  23.    Back        : BOOLEAN;
  24.    Ch          : CHAR;
  25.    Sysop_Found : BOOLEAN;
  26.  
  27. (*----------------------------------------------------------------------*)
  28. (*   Display_Host_Commands --- Display command list for remote user     *)
  29. (*----------------------------------------------------------------------*)
  30.  
  31. PROCEDURE Display_Host_Commands;
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*                                                                      *)
  35. (*     Procedure: Display_Host_Commands                                 *)
  36. (*                                                                      *)
  37. (*     Purpose:   Displays menu of PibTerm host commands and prompts    *)
  38. (*                for command entry.                                    *)
  39. (*                                                                      *)
  40. (*     Calling sequence:                                                *)
  41. (*                                                                      *)
  42. (*        Display_Host_Commands;                                        *)
  43. (*                                                                      *)
  44. (*----------------------------------------------------------------------*)
  45.  
  46. BEGIN (* Display_Host_Commands *)
  47.  
  48.    IF ( NOT Expert_On ) THEN
  49.       BEGIN
  50.          Host_Send_String_With_CR('======================================================');
  51.          Host_Send_String_With_CR('=             PibTerm Host Mode Main Menu            =');
  52.          Host_Send_String_With_CR('======================================================');
  53.          Host_Send_String_With_CR(' ');
  54.          Host_Send_String_With_CR('     E=Enter message');
  55.          Host_Send_String_With_CR('     R=Read message');
  56.          Host_Send_String_With_CR('     S=Scan messages');
  57.          Host_Send_String_With_CR('     P=Personal message scan');
  58.          Host_Send_String_With_CR('     Q=Quit and logoff');
  59.          Host_Send_String_With_CR('     F=File transfers');
  60.          Host_Send_String_With_CR('     G=Gossip mode');
  61.          Host_Send_String_With_CR('     X=Expert mode');
  62.          Host_Send_String_With_CR('     C=Send comments');
  63.          Host_Send_String_With_CR(' ');
  64.          Host_Send_String_With_CR('======================================================');
  65.          Host_Send_String_And_Echo('Enter command ? ');
  66.       END
  67.    ELSE
  68.       BEGIN
  69.          Host_Send_String_With_CR(' ');
  70.          Host_Send_String_And_Echo('Main (E,R,S,P,Q,F,G,X,C) ? ');
  71.       END;
  72.  
  73. END   (* Display_Host_Commands *);
  74.  
  75. (*----------------------------------------------------------------------*)
  76. (*           Get_A_Message  --- Get text of message from user           *)
  77. (*----------------------------------------------------------------------*)
  78.  
  79. PROCEDURE Get_A_Message( VAR F: Text_File );
  80.  
  81. (*----------------------------------------------------------------------*)
  82. (*                                                                      *)
  83. (*     Procedure:  Get_A_Message                                        *)
  84. (*                                                                      *)
  85. (*     Purpose:    Prompts for line by line message entry.              *)
  86. (*                                                                      *)
  87. (*     Calling Sequence:                                                *)
  88. (*                                                                      *)
  89. (*        Get_A_Message( VAR F: Text_File );                            *)
  90. (*                                                                      *)
  91. (*           F --- file to write message to.                            *)
  92. (*                                                                      *)
  93. (*     Remarks:                                                         *)
  94. (*                                                                      *)
  95. (*        This routine handles text entry for both regular messages and *)
  96. (*        comments.                                                     *)
  97. (*                                                                      *)
  98. (*----------------------------------------------------------------------*)
  99.  
  100. BEGIN (* Get_A_Message *)
  101.  
  102.    WITH User_List[Cur_User] DO
  103.       WRITELN( F, '== From:    ', Fname, ' ', Lname );
  104.    WRITELN( F, '== To:      ',Recipient_Name );
  105.    WRITELN( F, '== Date:    ',DateString );
  106.    WRITELN( F, '== Time:    ',TimeString( TimeOfDay ) );
  107.    WRITELN( F, '== Subject: ',Message_Subject );
  108.  
  109.    Host_Send_String( CR_LF_Host );
  110.    Host_Send_String_With_CR('Enter message.   Empty line terminates.');
  111.  
  112.    REPEAT
  113.       Host_Send_String( CR_LF_Host );
  114.       Host_Prompt_And_Read_String('> ', Message_Line, TRUE );
  115.       IF LENGTH( Message_Line ) > 0 THEN
  116.          WRITELN( F, Message_Line );
  117.    UNTIL ( LENGTH( Message_Line ) = 0 );
  118.  
  119.    WRITELN( F, '== End');
  120.  
  121.    Host_Send_String( CR_LF_Host );
  122.    Host_Send_String_With_CR('Message entered.');
  123.  
  124. END   (* Get_A_Message *);
  125.  
  126. (*----------------------------------------------------------------------*)
  127. (*           Enter_Message  --- Enter a message into message base       *)
  128. (*----------------------------------------------------------------------*)
  129.  
  130. PROCEDURE Enter_Message;
  131.  
  132. (*----------------------------------------------------------------------*)
  133. (*                                                                      *)
  134. (*     Procedure:  Enter_Message                                        *)
  135. (*                                                                      *)
  136. (*     Purpose:    Enters message into message base.                    *)
  137. (*                                                                      *)
  138. (*     Calling Sequence:                                                *)
  139. (*                                                                      *)
  140. (*        Enter_Message;                                                *)
  141. (*                                                                      *)
  142. (*----------------------------------------------------------------------*)
  143.  
  144. VAR
  145.    Quit: BOOLEAN;
  146.  
  147. BEGIN (* Enter_Message *)
  148.  
  149.    Quit := FALSE;
  150.                                    (* Open message file *)
  151.  
  152.    ASSIGN( Message_File, Home_Dir + 'PIBTERM.MSG' );
  153.       (*$I-*)
  154.    RESET ( Message_File );
  155.       (*$I+*)
  156.                                    (* If it exists, open for append.       *)
  157.                                    (* If it doesn't exist, open for write. *)
  158.    IF Int24Result <> 0 THEN
  159.       BEGIN
  160.          WRITELN('Creating message file PIBTERM.MSG');
  161.             (*$I-*)
  162.          REWRITE( Message_File );
  163.             (*$I+*)
  164.          IF Int24Result <> 0 THEN
  165.             BEGIN
  166.                Host_Send_String_With_CR('Sorry, no more room for messages');
  167.                Quit := TRUE;
  168.             END;
  169.       END
  170.    ELSE
  171.       BEGIN
  172.             (*$I-*)
  173.          CLOSE( Message_File );
  174.  
  175.          APPEND( Message_File );
  176.             (*$I+*)
  177.  
  178.          IF Int24Result <> 0 THEN
  179.             BEGIN
  180.                Host_Send_String( CR_LF_Host );
  181.                Host_Send_String_With_CR('Sorry, no more room for messages');
  182.                Quit := TRUE;
  183.             END;
  184.       END;
  185.  
  186.    Host_Send_String( CR_LF_Host );
  187.    Host_Prompt_And_Read_String('Enter recipient''s name or ALL: ',
  188.                                   Recipient_Name, TRUE );
  189.  
  190.    Recipient_Name := UpperCase( TRIM( Recipient_Name ) );
  191.  
  192.    IF Recipient_Name = '' THEN
  193.       Recipient_Name := 'ALL';
  194.  
  195.    Host_Send_String( CR_LF_Host );
  196.    Host_Prompt_And_Read_String('Enter title for message: ',
  197.                                   Message_Subject, TRUE );
  198.  
  199.    IF ( NOT Quit ) THEN
  200.       Get_A_Message( Message_File );
  201.  
  202.       (*$I-*)
  203.    CLOSE ( Message_File );
  204.       (*$I+*)
  205.                                    (* Increment message count *)
  206.    NMessages := NMessages + 1;
  207.  
  208. END   (* Enter_Message *);
  209.  
  210. (*----------------------------------------------------------------------*)
  211. (*    Skip_To_Message  --- Skip to specified message in message base    *)
  212. (*----------------------------------------------------------------------*)
  213.  
  214. PROCEDURE Skip_To_Message( Msg_No : INTEGER );
  215.  
  216. (*----------------------------------------------------------------------*)
  217. (*                                                                      *)
  218. (*     Procedure:  Skip_To_Message                                      *)
  219. (*                                                                      *)
  220. (*     Purpose:    Skip to specified message in message base.           *)
  221. (*                                                                      *)
  222. (*     Calling Sequence:                                                *)
  223. (*                                                                      *)
  224. (*        Skip_To_Message( Msg_No : INTEGER );                          *)
  225. (*                                                                      *)
  226. (*           Msg_No --- Message to skip to.                             *)
  227. (*                                                                      *)
  228. (*     Remarks:                                                         *)
  229. (*                                                                      *)
  230. (*        The message file must be opened before this routine is        *)
  231. (*        called.                                                       *)
  232. (*                                                                      *)
  233. (*----------------------------------------------------------------------*)
  234.  
  235. VAR
  236.    Msg_Count : INTEGER;
  237.  
  238. BEGIN (* Skip_To_Message *)
  239.  
  240.    Msg_Count := 0;
  241.  
  242.    REPEAT
  243.  
  244.       READLN( Message_File , Message_Line );
  245.  
  246.       IF COPY( Message_Line, 1, 6 ) = '== End' THEN
  247.          Msg_Count := Msg_Count + 1;
  248.  
  249.    UNTIL ( Msg_Count = ( Msg_No - 1 ) );
  250.  
  251. END   (* Skip_To_Message *);
  252.  
  253. (*----------------------------------------------------------------------*)
  254. (*             Read_Messages  --- Read messages from message base       *)
  255. (*----------------------------------------------------------------------*)
  256.  
  257. PROCEDURE Read_Messages;
  258.  
  259. (*----------------------------------------------------------------------*)
  260. (*                                                                      *)
  261. (*     Procedure:  Read_Messages                                        *)
  262. (*                                                                      *)
  263. (*     Purpose:    Reads messages currently in message base.            *)
  264. (*                                                                      *)
  265. (*     Calling Sequence:                                                *)
  266. (*                                                                      *)
  267. (*        Read_Messages;                                                *)
  268. (*                                                                      *)
  269. (*----------------------------------------------------------------------*)
  270.  
  271. VAR
  272.    Message_No   : INTEGER;
  273.    CMessage_No  : STRING[5];
  274.    I            : INTEGER;
  275.    Line_Count   : INTEGER;
  276.    Read_Done    : BOOLEAN;
  277.    Start_Msg    : INTEGER;
  278.    Start_M_Str  : AnyStr;
  279.    OK_Number    : BOOLEAN;
  280.  
  281. LABEL
  282.    Reading_Done;
  283.  
  284. BEGIN (* Read_Messages *)
  285.                                    (* Open message file *)
  286.  
  287.    ASSIGN( Message_File , Home_Dir + 'PIBTERM.MSG' );
  288.       (*$I-*)
  289.    RESET( Message_File );
  290.       (*$I+*)
  291.                                    (* Not there -- no messages *)
  292.    IF Int24Result <> 0 THEN
  293.       BEGIN
  294.          Host_Send_String( CR_LF_Host );
  295.          Host_Send_String_With_CR('No messages in message file.');
  296.          EXIT;
  297.       END;
  298.                                    (* Find where to start *)
  299.  
  300.    OK_Number := TRUE;
  301.  
  302.    REPEAT
  303.  
  304.       Host_Send_String_With_CR(' ');
  305.       Host_Prompt_And_Read_String('Enter message to start at or <CR> for all: ',
  306.                                    Start_M_Str, TRUE );
  307.       Start_Msg := 0;
  308.       FOR I := 1 TO LENGTH( Start_M_Str ) DO
  309.          IF ( Start_M_Str[I] IN ['0'..'9'] ) THEN
  310.             Start_Msg := Start_Msg * 10 + ORD( Start_M_Str[I] ) - ORD('0')
  311.          ELSE
  312.             OK_Number := FALSE;
  313.  
  314.       IF Start_Msg = 0 THEN Start_Msg := 1;
  315.       IF Start_Msg > NMessages THEN Start_Msg := NMessages;
  316.  
  317.    UNTIL ( NOT Host_Carrier_Detect ) OR ( OK_Number );
  318.  
  319.    IF ( NOT Host_Carrier_Detect ) THEN GOTO Reading_Done;
  320.  
  321.                                    (* Skip to desired message *)
  322.    Skip_To_Message( Start_Msg );
  323.  
  324.                                    (* Messages always start at one *)
  325.    Message_No := Start_Msg - 1;
  326.    Read_Done  := FALSE;
  327.    Line_Count := 0;
  328.                                    (* Loop over messages *)
  329.    REPEAT
  330.                                    (* Increment message number *)
  331.  
  332.       Message_No := Message_No + 1;
  333.  
  334.       STR( Message_No : 5 , CMessage_No );
  335.  
  336.       Host_Send_String( CR_LF_Host );
  337.       List_Prompt( Line_Count , Read_Done );
  338.       IF Read_Done THEN GOTO Reading_Done;
  339.  
  340.       Host_Send_String_With_CR('Message #' + CMessage_No);
  341.       List_Prompt( Line_Count , Read_Done );
  342.       IF Read_Done THEN GOTO Reading_Done;
  343.  
  344.                                    (* Display message # and header info *)
  345.       FOR I := 1 TO 5 DO
  346.          BEGIN
  347.             READLN( Message_File , Message_Line );
  348.             Message_Line := COPY( Message_Line, 4,
  349.                                   LENGTH( Message_Line ) - 3 );
  350.             Host_Send_String_With_CR( Message_Line );
  351.             List_Prompt( Line_Count , Read_Done );
  352.             IF Read_Done THEN GOTO Reading_Done;
  353.          END;
  354.  
  355.       Host_Send_String_With_CR(' ');
  356.       List_Prompt( Line_Count , Read_Done );
  357.       IF Read_Done THEN GOTO Reading_Done;
  358.  
  359.                                    (* Display body of message *)
  360.       REPEAT
  361.  
  362.          READLN( Message_File , Message_Line );
  363.  
  364.          IF ( COPY( Message_Line, 1, 6 ) <> '== End' ) THEN
  365.             BEGIN
  366.                Host_Send_String_With_CR( COPY( Message_Line, 2,
  367.                                                 LENGTH( Message_Line ) - 1 ) );
  368.                List_Prompt( Line_Count , Read_Done );
  369.             END;
  370.  
  371.       UNTIL ( COPY( Message_Line, 1, 6 ) = '== End' ) OR ( Read_Done );
  372.  
  373.    UNTIL ( Message_No >= NMessages ) OR Read_Done;
  374.  
  375. Reading_Done:
  376.  
  377.       (*$I-*)
  378.    CLOSE( Message_File );
  379.       (*$I+*)
  380.  
  381. END   (* Read_Messages *);
  382.  
  383. (*----------------------------------------------------------------------*)
  384. (*             Scan_Messages  --- Scan messages from message base       *)
  385. (*----------------------------------------------------------------------*)
  386.  
  387. PROCEDURE Scan_Messages( Personal_Only : BOOLEAN );
  388.  
  389. (*----------------------------------------------------------------------*)
  390. (*                                                                      *)
  391. (*     Procedure:  Scan_Messages                                        *)
  392. (*                                                                      *)
  393. (*     Purpose:    Scans message headers currently in message base.     *)
  394. (*                                                                      *)
  395. (*     Calling Sequence:                                                *)
  396. (*                                                                      *)
  397. (*        Scan_Messages( Personal_Only : BOOLEAN );                     *)
  398. (*                                                                      *)
  399. (*           Personal_Only --- Return messages addressed to current     *)
  400. (*                             user only.                               *)
  401. (*                                                                      *)
  402. (*----------------------------------------------------------------------*)
  403.  
  404. VAR
  405.    Message_Title: AnyStr;
  406.    Message_No   : INTEGER;
  407.    CMessage_No  : STRING[5];
  408.    I            : INTEGER;
  409.    Line_Count   : INTEGER;
  410.    Scan_Done    : BOOLEAN;
  411.    OK_Number    : BOOLEAN;
  412.    Start_Msg    : INTEGER;
  413.    Start_M_Str  : AnyStr;
  414.    Message_L1   : AnyStr;
  415.    Message_L2   : AnyStr;
  416.    Msg_Count    : INTEGER;
  417.  
  418. LABEL
  419.    Scanning_Done;
  420.  
  421. BEGIN (* Scan_Messages *)
  422.                                    (* Open message file *)
  423.  
  424.    ASSIGN( Message_File , Home_Dir + 'PIBTERM.MSG' );
  425.       (*$I-*)
  426.    RESET( Message_File );
  427.       (*$I+*)
  428.                                    (* Not there -- no messages *)
  429.    IF Int24Result <> 0 THEN
  430.       BEGIN
  431.          Host_Send_String( CR_LF_Host );
  432.          Host_Send_String_With_CR('No messages in message file.');
  433.          GOTO Scanning_Done;
  434.       END;
  435.                                    (* Find where to start -- if only *)
  436.                                    (* personal messages, always scan *)
  437.                                    (* entire message base.           *)
  438.    OK_Number := TRUE;
  439.    Start_Msg := 1;
  440.  
  441.    IF ( NOT Personal_Only ) THEN
  442.       REPEAT
  443.                                    (* Request starting message number *)
  444.  
  445.          Host_Send_String_With_CR(' ');
  446.          Host_Prompt_And_Read_String('Enter message to start at or <CR> for all: ',
  447.                                       Start_M_Str, TRUE );
  448.  
  449.                                    (* Convert response to message number *)
  450.          Start_Msg := 0;
  451.  
  452.          FOR I := 1 TO LENGTH( Start_M_Str ) DO
  453.             IF ( Start_M_Str[I] IN ['0'..'9'] ) THEN
  454.                Start_Msg := Start_Msg * 10 + ORD( Start_M_Str[I] ) - ORD('0')
  455.             ELSE
  456.                OK_Number := FALSE;
  457.                                    (* Ensure message is in range *)
  458.  
  459.          IF Start_Msg = 0 THEN Start_Msg := 1;
  460.          IF Start_Msg > NMessages THEN Start_Msg := NMessages;
  461.  
  462.       UNTIL ( NOT Host_Carrier_Detect ) OR ( OK_Number );
  463.  
  464.    IF ( NOT Host_Carrier_Detect ) THEN GOTO Scanning_Done;
  465.  
  466.                                    (* Skip to desired message *)
  467.    Skip_To_Message( Start_Msg );
  468.                                    (* Messages always start at one *)
  469.    Message_No := Start_Msg - 1;
  470.    Line_Count := 0;
  471.    Scan_Done  := FALSE;
  472.    Msg_Count  := 0;
  473.                                    (* Loop over messages *)
  474.    REPEAT
  475.                                    (* Increment message number *)
  476.       Message_No := Message_No + 1;
  477.  
  478.                                    (* Read 1st two lines of message *)
  479.  
  480.       READLN( Message_File , Message_L1 );
  481.       READLN( Message_File , Message_L2 );
  482.  
  483.                                    (* Check if recipient is current user *)
  484.  
  485.       IF ( COPY( Message_L2, 13, LENGTH( Message_L2 ) - 12 ) =
  486.            Cur_User_Name ) OR ( NOT Personal_Only ) THEN
  487.  
  488.          BEGIN (* Display this message *)
  489.  
  490.                                    (* Increment personal messages count *)
  491.  
  492.             Msg_Count := Msg_Count + 1;
  493.  
  494.             STR( Message_No : 5 , CMessage_No );
  495.  
  496.             Host_Send_String( CR_LF_Host );
  497.             List_Prompt( Line_Count , Scan_Done );
  498.             IF Scan_Done THEN GOTO Scanning_Done;
  499.  
  500.                                    (* Display message number *)
  501.  
  502.             Host_Send_String_With_CR('Message #' + CMessage_No );
  503.             List_Prompt( Line_Count , Scan_Done );
  504.             IF Scan_Done THEN GOTO Scanning_Done;
  505.  
  506.                                    (* Display 1st 2 header lines *)
  507.  
  508.             Host_Send_String_With_CR( COPY( Message_L1, 4,
  509.                                        LENGTH( Message_L1 ) - 3 ) );
  510.             List_Prompt( Line_Count , Scan_Done );
  511.             IF Scan_Done THEN GOTO Scanning_Done;
  512.  
  513.             Host_Send_String_With_CR( COPY( Message_L2, 4,
  514.                                        LENGTH( Message_L2 ) - 3 ) );
  515.             List_Prompt( Line_Count , Scan_Done );
  516.             IF Scan_Done THEN GOTO Scanning_Done;
  517.  
  518.                                    (* Display remaining header info *)
  519.             FOR I := 3 TO 5 DO
  520.                BEGIN
  521.                   READLN( Message_File , Message_Line );
  522.                   Message_Line := COPY( Message_Line, 4,
  523.                                         LENGTH( Message_Line ) - 3 );
  524.                   Host_Send_String_With_CR( Message_Line );
  525.                   List_Prompt( Line_Count , Scan_Done );
  526.                   IF Scan_Done THEN GOTO Scanning_Done;
  527.                END;
  528.  
  529.             Host_Send_String_With_CR(' ');
  530.             List_Prompt( Line_Count , Scan_Done );
  531.  
  532.          END (* Display this message *);
  533.  
  534.                                    (* Scan for end of message *)
  535.       IF ( NOT Scan_Done ) THEN
  536.          REPEAT
  537.             READLN( Message_File , Message_Line );
  538.          UNTIL ( COPY( Message_Line, 1, 6 ) = '== End' );
  539.  
  540.    UNTIL ( Message_No >= NMessages ) OR ( Scan_Done );
  541.  
  542. Scanning_Done:
  543.  
  544.       (*$I-*)
  545.    CLOSE( Message_File );
  546.       (*$I+*)
  547.                                    (* Notify user if no personal messages *)
  548.    IF Personal_Only THEN
  549.       IF Msg_Count = 0 THEN
  550.          BEGIN
  551.             Host_Send_String_With_CR(' ');
  552.             Host_Send_String_With_CR('You have no personal messages waiting.');
  553.          END;
  554.  
  555. END   (* Scan_Messages *);
  556.  
  557. (*----------------------------------------------------------------------*)
  558. (*                   Enter_Comment  --- Enter a comment                 *)
  559. (*----------------------------------------------------------------------*)
  560.  
  561. PROCEDURE Enter_Comment;
  562.  
  563. (*----------------------------------------------------------------------*)
  564. (*                                                                      *)
  565. (*     Procedure:  Enter_Comment                                        *)
  566. (*                                                                      *)
  567. (*     Purpose:    Enters comment into comment file.                    *)
  568. (*                                                                      *)
  569. (*     Calling Sequence:                                                *)
  570. (*                                                                      *)
  571. (*        Enter_Comment;                                                *)
  572. (*                                                                      *)
  573. (*     Remarks:                                                         *)
  574. (*                                                                      *)
  575. (*        The comments file is PIBTERM.CMT.                             *)
  576. (*                                                                      *)
  577. (*----------------------------------------------------------------------*)
  578.  
  579. VAR
  580.    Quit: BOOLEAN;
  581.  
  582. BEGIN (* Enter_Comment *)
  583.  
  584.    Quit := FALSE;
  585.                                    (* Open comments file *)
  586.  
  587.    ASSIGN( Comments_File, Home_Dir + 'PIBTERM.CMT' );
  588.       (*$I-*)
  589.    RESET ( Comments_File );
  590.       (*$I+*)
  591.                                    (* If it exists, open for append.       *)
  592.                                    (* If it doesn't exist, open for write. *)
  593.    IF Int24Result <> 0 THEN
  594.       BEGIN
  595.          WRITELN('Creating comments file PIBTERM.CMT');
  596.             (*$I-*)
  597.          REWRITE( Comments_File );
  598.             (*$I+*)
  599.          IF Int24Result <> 0 THEN
  600.             BEGIN
  601.                Host_Send_String( CR_LF_Host );
  602.                Host_Send_String_With_CR('Sorry, can''t accept comments now.');
  603.                Quit := TRUE;
  604.             END;
  605.       END
  606.    ELSE
  607.       BEGIN
  608.             (*$I-*)
  609.          CLOSE( Comments_File );
  610.  
  611.          APPEND( Comments_File );
  612.             (*$I+*)
  613.  
  614.          IF Int24Result <> 0 THEN
  615.             BEGIN
  616.                Host_Send_String( CR_LF_Host );
  617.                Host_Send_String_With_CR('Sorry, can''t accept comments now.');
  618.                Quit := TRUE;
  619.             END;
  620.       END;
  621.  
  622.    Recipient_Name  := 'SYSOP';
  623.    Message_Subject := ' ';
  624.  
  625.    IF ( NOT Quit ) THEN
  626.       Get_A_Message( Comments_File );
  627.  
  628.       (*$I-*)
  629.    CLOSE ( Comments_File );
  630.       (*$I+*)
  631.  
  632. END   (* Enter_Comment *);
  633.  
  634. (*----------------------------------------------------------------------*)
  635.  
  636. BEGIN (* Process_Host_Commands *)
  637.  
  638.                                    (* Scan for personal mail on *)
  639.                                    (* first entry here.         *)
  640.    IF Host_Section = 'I' THEN
  641.       BEGIN
  642.  
  643.          Host_Send_String_With_CR(' ');
  644.          Host_Send_String_With_CR('Scanning for personal messages ... ');
  645.  
  646.          Scan_Messages( TRUE );
  647.  
  648.          Host_Section := 'M';
  649.  
  650.       END;
  651.                                    (* Prompt for commands *)
  652.    Display_Host_Commands;
  653.                                    (* Assume input from remote *)
  654.    Kbd_Input := FALSE;
  655.                                    (* Wait for command to be entered *)
  656.    REPEAT
  657.       Done := Done OR ( NOT Host_Carrier_Detect );
  658.    UNTIL Done OR Async_Receive( Ch ) OR KeyPressed;
  659.  
  660.                                    (* Process input from keyboard *)
  661.    IF KeyPressed THEN
  662.       BEGIN
  663.          READ( KBD , Ch );
  664.          Kbd_Input := TRUE;
  665.          IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
  666.             BEGIN
  667.                READ( Kbd, Ch );
  668.                IF ORD( Ch ) = F1 THEN
  669.                   Ch := 'G'
  670.                ELSE IF ORD( Ch ) = F2 THEN
  671.                   Ch := 'Q';
  672.             END;
  673.       END;
  674.  
  675.    IF ( Not DONE ) THEN
  676.                                    (* Echo command *)
  677.  
  678.       Host_Send_String( Ch + CR_LF_Host );
  679.       WRITELN;
  680.       IF Printer_On THEN
  681.          WRITELN( Lst, Ch );
  682.       IF Capture_On THEN
  683.          WRITELN( Capture_File, Ch );
  684.  
  685.                                    (* Process command request *)
  686.       CASE UpCase( Ch ) OF
  687.  
  688.          'E':  Enter_Message;
  689.          'R':  Read_Messages;
  690.          'Q':  BEGIN
  691.                   IF Kbd_Input THEN
  692.                      BEGIN
  693.                         Host_Send_String_With_CR('System operator shutting ' +
  694.                                                   ' down system.');
  695.                         Host_Send_String_With_CR('Thanks for calling.');
  696.                         Done := TRUE;
  697.                      END
  698.                   ELSE
  699.                      BEGIN
  700.                         Host_Send_String_With_CR('Quit and logoff');
  701.                         Done := TRUE;
  702.                      END;
  703.                END;
  704.          'F':  Host_Section := 'F';
  705.          'G':  BEGIN
  706.                   IF Kbd_Input THEN
  707.                      BEGIN
  708.                         Host_Send_String_With_CR(' ... System operator wishes' +
  709.                                                   ' to chat, please wait ...');
  710.                         Host_Send_String_With_CR(' ');
  711.                         Gossip_Mode;
  712.                      END
  713.                   ELSE
  714.                      BEGIN
  715.                         Page_Sysop( Sysop_Found );
  716.                         IF Sysop_Found THEN Gossip_Mode;
  717.                      END;
  718.                END;
  719.          'C':  Enter_Comment;
  720.          'P':  Scan_Messages( TRUE );
  721.          'X':  Expert_On := NOT Expert_On;
  722.          'S':  Scan_Messages( FALSE );
  723.          ELSE  Host_Send_String( ^G );
  724.  
  725.       END (* CASE *)
  726.  
  727. END   (* Process_Host_Commands *);
  728.  
  729. (*----------------------------------------------------------------------*)
  730. (*           Get_UserInfo --- Read in user name and password            *)
  731. (*----------------------------------------------------------------------*)
  732.  
  733. OVERLAY PROCEDURE Get_UserInfo( VAR Found: BOOLEAN );
  734.  
  735. (*----------------------------------------------------------------------*)
  736. (*                                                                      *)
  737. (*     Procedure:  Get_UserInfo                                         *)
  738. (*                                                                      *)
  739. (*     Purpose:    Gets user name and password from remote user.        *)
  740. (*                                                                      *)
  741. (*     Calling Sequence:                                                *)
  742. (*                                                                      *)
  743. (*        Get_UserInfo( VAR Found: BOOLEAN );                           *)
  744. (*                                                                      *)
  745. (*           Done --- set TRUE if user name found and carrier not       *)
  746. (*                    dropped.                                          *)
  747. (*                                                                      *)
  748. (*----------------------------------------------------------------------*)
  749.  
  750. VAR
  751.    MyPass: AnyStr;
  752.  
  753. BEGIN (* Get_UserInfo *)
  754.                                    (* Open log file and record this login *)
  755.  
  756.    ASSIGN( Log_File, 'PIBTERM.LOG' );
  757.       (*$I-*)
  758.    RESET ( Log_File );
  759.       (*$I+*)
  760.  
  761.    IF Int24Result = 0 THEN
  762.       BEGIN
  763.          CLOSE( Log_File );
  764.          APPEND( Log_File );
  765.       END
  766.    ELSE
  767.       REWRITE( Log_File );
  768.  
  769.                                    (* Prompt for first name *)
  770.  
  771.    Host_Send_String_With_CR(' ');
  772.    Host_Prompt_And_Read_String('Enter first name: ', Fname, TRUE );
  773.    Fname := TRIM( UpperCase( Fname ) );
  774.  
  775.                                    (* Prompt for second name *)
  776.  
  777.    Host_Send_String_With_CR(' ');
  778.    Host_Prompt_And_Read_String('Enter last name:  ', Lname, TRUE );
  779.    Lname := TRIM( UpperCase( Lname ) );
  780.  
  781.                                    (* See if valid user name *)
  782.    Cur_User := 0;
  783.    Found    := FALSE;
  784.  
  785.    REPEAT
  786.       Cur_User := Cur_User + 1;
  787.       WITH User_List[Cur_User] DO
  788.          Found := ( Fname = First_Name ) AND ( Lname = Last_Name );
  789.    UNTIL ( Found OR ( Cur_User >= MaxUsers ) );
  790.  
  791.                                    (* Remember name for message scans *)
  792.  
  793.    Cur_User_Name := Fname + ' ' + Lname;
  794.  
  795.                                    (* Error if name not in user file *)
  796.    IF ( NOT Found ) THEN
  797.       BEGIN
  798.          Host_Send_String_With_CR(' ');
  799.          Host_Send_String_With_CR('Not a valid user name.');
  800.       END;
  801.                                    (* Prompt for password *)
  802.  
  803.    IF ( Found AND Async_Carrier_Detect ) THEN
  804.       BEGIN
  805.  
  806.          Host_Send_String_With_CR(' ');
  807.          Host_Prompt_And_Read_String('Enter Password:   ', MyPass, FALSE );
  808.          Host_Send_String_With_CR(' ');
  809.  
  810.                                    (* Check if password valid *)
  811.  
  812.          IF MyPass = User_List[Cur_User].PassWord THEN
  813.             BEGIN
  814.  
  815.                Host_Send_String_With_CR('Password OK');
  816.  
  817.                Found := TRUE;
  818.  
  819.                WRITELN( Log_File,Fname,' ',Lname,' logged on at ',
  820.                         TimeString( TimeOfDay ), ' on ',DateString );
  821.                IF Printer_On THEN
  822.                   WRITELN( Lst , Fname,' ',Lname,' logged on at ',
  823.                            TimeString( TimeOfDay ), ' on ',DateString );
  824.                IF Capture_On THEN
  825.                   WRITELN( Capture_File , Fname,' ',Lname,' logged on at ',
  826.                            TimeString( TimeOfDay ), ' on ',DateString );
  827.  
  828.             END
  829.          ELSE
  830.             BEGIN
  831.  
  832.                Host_Send_String_With_CR('Password wrong');
  833.  
  834.                Found := FALSE;
  835.  
  836.                WRITELN( Log_File,Fname,' ',Lname,' logon try at ',
  837.                         TimeString( TimeOfDay ), ' on ',DateString,
  838.                         ' password entered = ', MyPass );
  839.                IF Printer_On THEN
  840.                   WRITELN( Lst , Fname,' ',Lname,' logon try at ',
  841.                            TimeString( TimeOfDay ), ' on ',DateString,
  842.                            ' password entered = ', MyPass );
  843.                IF Capture_On THEN
  844.                   WRITELN( Capture_File , Fname,' ',Lname,' logon try at ',
  845.                            TimeString( TimeOfDay ), ' on ',DateString,
  846.                            ' password entered = ', MyPass );
  847.             END;
  848.  
  849.    END;
  850.  
  851.       (*$I-*)
  852.    CLOSE( Log_File );
  853.       (*$I+*)
  854.  
  855. END   (* Get_UserInfo *);
  856.